home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 24 / AACD 24.iso / AACD / Programming / cvs-1.11.1 / contrib / log < prev    next >
Text File  |  2001-01-01  |  5KB  |  209 lines
  1. #! /usr/bin/perl
  2. # -*-Perl-*-
  3. #
  4. # XXX: FIXME: handle multiple '-f logfile' arguments
  5. #
  6. # XXX -- I HATE Perl!  This *will* be re-written in shell/awk/sed soon!
  7. #
  8.  
  9. # Usage:  log.pl [-u user] [[-m mailto] ...] [-s] [-V] -f logfile 'dirname file ...'
  10. #
  11. #    -u user        - $USER passed from loginfo
  12. #    -m mailto    - for each user to receive cvs log reports
  13. #            (multiple -m's permitted)
  14. #    -s        - to prevent "cvs status -v" messages
  15. #    -V        - without '-s', don't pass '-v' to cvs status
  16. #    -f logfile    - for the logfile to append to (mandatory,
  17. #            but only one logfile can be specified).
  18.  
  19. # here is what the output looks like:
  20. #
  21. #    From: woods@kuma.domain.top
  22. #    Subject: CVS update: testmodule
  23. #
  24. #    Date: Wednesday November 23, 1994 @ 14:15
  25. #    Author: woods
  26. #
  27. #    Update of /local/src-CVS/testmodule
  28. #    In directory kuma:/home/kuma/woods/work.d/testmodule
  29. #    
  30. #    Modified Files:
  31. #        test3 
  32. #    Added Files:
  33. #        test6 
  34. #    Removed Files:
  35. #        test4 
  36. #    Log Message:
  37. #    - wow, what a test
  38. #
  39. # (and for each file the "cvs status -v" output is appended unless -s is used)
  40. #
  41. #    ==================================================================
  42. #    File: test3               Status: Up-to-date
  43. #    
  44. #       Working revision:    1.41    Wed Nov 23 14:15:59 1994
  45. #       Repository revision:    1.41    /local/src-CVS/cvs/testmodule/test3,v
  46. #       Sticky Options:    -ko
  47. #    
  48. #       Existing Tags:
  49. #        local-v2                     (revision: 1.7)
  50. #        local-v1                     (revision: 1.1.1.2)
  51. #        CVS-1_4A2                    (revision: 1.1.1.2)
  52. #        local-v0                     (revision: 1.2)
  53. #        CVS-1_4A1                    (revision: 1.1.1.1)
  54. #        CVS                          (branch: 1.1.1)
  55.  
  56. use strict;
  57. use IO::File;
  58.  
  59. my $cvsroot = $ENV{'CVSROOT'};
  60.  
  61. # turn off setgid
  62. #
  63. $) = $(;
  64.  
  65. my $dostatus = 1;
  66. my $verbosestatus = 1;
  67. my $users;
  68. my $login;
  69. my $donefiles;
  70. my $logfile;
  71. my @files;
  72.  
  73. # parse command line arguments
  74. #
  75. while (@ARGV) {
  76.     my $arg = shift @ARGV;
  77.  
  78.     if ($arg eq '-m') {
  79.         $users = "$users " . shift @ARGV;
  80.     } elsif ($arg eq '-u') {
  81.         $login = shift @ARGV;
  82.     } elsif ($arg eq '-f') {
  83.         ($logfile) && die "Too many '-f' args";
  84.         $logfile = shift @ARGV;
  85.     } elsif ($arg eq '-s') {
  86.         $dostatus = 0;
  87.     } elsif ($arg eq '-V') {
  88.         $verbosestatus = 0;
  89.     } else {
  90.         ($donefiles) && die "Too many arguments!\n";
  91.         $donefiles = 1;
  92.         @files = split(/ /, $arg);
  93.     }
  94. }
  95.  
  96. # the first argument is the module location relative to $CVSROOT
  97. #
  98. my $modulepath = shift @files;
  99.  
  100. my $mailcmd = "| Mail -s 'CVS update: $modulepath'";
  101.  
  102. # Initialise some date and time arrays
  103. #
  104. my @mos = ('January','February','March','April','May','June','July',
  105.     'August','September','October','November','December');
  106. my @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  107.  
  108. my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
  109. $year += 1900;
  110.  
  111. # get a login name for the guy doing the commit....
  112. #
  113. if ($login eq '') {
  114.     $login = getlogin || (getpwuid($<))[0] || "nobody";
  115. }
  116.  
  117. # open log file for appending
  118. #
  119. my $logfh = new IO::File ">>" . $logfile
  120.     or die "Could not open(" . $logfile . "): $!\n";
  121.  
  122. # send mail, if there's anyone to send to!
  123. #
  124. my $mailfh;
  125. if ($users) {
  126.     $mailcmd = "$mailcmd $users";
  127.     $mailfh = new IO::File $mailcmd
  128.         or die "Could not Exec($mailcmd): $!\n";
  129. }
  130.  
  131. # print out the log Header
  132. #
  133. $logfh->print ("\n");
  134. $logfh->print ("****************************************\n");
  135. $logfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n");
  136. $logfh->print ("Author:\t$login\n\n");
  137.  
  138. if ($mailfh) {
  139.     $mailfh->print ("\n");
  140.     $mailfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n");
  141.     $mailfh->print ("Author:\t$login\n\n");
  142. }
  143.  
  144. # print the stuff from logmsg that comes in on stdin to the logfile
  145. #
  146. my $infh = new IO::File "< -";
  147. foreach ($infh->getlines) {
  148.     $logfh->print;
  149.     if ($mailfh) {
  150.         $mailfh->print ($_);
  151.     }
  152. }
  153. undef $infh;
  154.  
  155. $logfh->print ("\n");
  156.  
  157. # after log information, do an 'cvs -Qq status -v' on each file in the arguments.
  158. #
  159. if ($dostatus != 0) {
  160.     while (@files) {
  161.         my $file = shift @files;
  162.         if ($file eq "-") {
  163.             $logfh->print ("[input file was '-']\n");
  164.             if ($mailfh) {
  165.                 $mailfh->print ("[input file was '-']\n");
  166.             }
  167.             last;
  168.         }
  169.         my $rcsfh = new IO::File;
  170.         my $pid = $rcsfh->open ("-|");
  171.         if ( !defined $pid )
  172.         {
  173.             die "fork failed: $!";
  174.         }
  175.         if ($pid == 0)
  176.         {
  177.             my @command = ('cvs', '-nQq', 'status');
  178.             if ($verbosestatus)
  179.             {
  180.                 push @command, '-v';
  181.             }
  182.             push @command, $file;
  183.             exec @command;
  184.             die "cvs exec failed: $!";
  185.         }
  186.         my $line;
  187.         while ($line = $rcsfh->getline) {
  188.             $logfh->print ($line);
  189.             if ($mailfh) {
  190.                 $mailfh->print ($line);
  191.             }
  192.         }
  193.         undef $rcsfh;
  194.     }
  195. }
  196.  
  197. $logfh->close()
  198.     or die "Write to $logfile failed: $!";
  199.  
  200. if ($mailfh)
  201. {
  202.     $mailfh->close;
  203.     die "Pipe to $mailcmd failed" if $?;
  204. }
  205.  
  206. ## must exit cleanly
  207. ##
  208. exit 0;
  209.